home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / radioGroup < prev    next >
Encoding:
Text File  |  1994-11-06  |  3.2 KB  |  168 lines  |  [TEXT/MSET]
  1.  \ 28Oct94 dbh updated to 2.5 syntax
  2.   \ 06Nov94 dbh reverted to obj_array, which is fixed with 2.5
  3.  
  4. (*
  5. A radioGroup is an array of radio buttons, we normally would neveer use
  6. a radio button except as part of a group.  The buttons are vertically
  7. aligned and behave as expected.  We optionally use init: to set the initial
  8. position and which button will be the first to be set.  We use get: to
  9. inspect which button is now on, get: returns the zero-based indice of
  10. the currently selected button.  A radioGroup is a selection object.
  11.  
  12. *)
  13.  
  14. :class radioBut super{ pushButton }
  15.     int index        \ each button must know its index number, 0,1,2,3,etc.
  16.     DICADDR theGroup    \ each button must know the owning group because of the
  17.             \ way exec: is invoked, we need to communicate back to the owning group
  18.  
  19. :m classinit:
  20.     classinit: super
  21.     konst radioButProc put: procID
  22.     " RadioButton" put: cTitle
  23.     ;m
  24.  
  25. :m init:  ( radioGroup idx -- )
  26.     put: index
  27.     put: theGroup ;m
  28.  
  29. :m exec:  ( part# -- )
  30.     IF
  31.         get: index put: [ get: theGroup ]
  32.         get: action execute
  33.     THEN ;m
  34.  
  35. ;class
  36.  
  37.  
  38. :class radioGroup super{ radioBut obj_array }
  39.     int top
  40.     int left
  41.     int yspacing
  42.     int nowOn    \ will default to zero
  43.  
  44. :m init:  ( x y firston -- )
  45.     dup limit: super 1 - > abort" firstOn in radioGroup is out of range"
  46.     put: nowOn
  47.     put: top
  48.     put: left
  49.     ;m
  50.  
  51. private
  52.  
  53. :m othersOff:  { idx -- }
  54.     limit: self  0    \ indexed-obj method
  55.     ?DO
  56.         i idx =    \ in case we hit the button currently on, avoid flicker
  57.         NIF
  58.             i select: super> obj_array
  59.             0 put: super> radioBut
  60.         THEN
  61.     LOOP ;m
  62.     
  63.  
  64. public
  65.  
  66. :m classinit:
  67.     0 put: nowOn
  68.     20 put: top
  69.     20 put: left
  70.     17 put: yspacing
  71. \    selfinit: super        \ should normally call this for obj_array's
  72.     \ now we can set each control's index to the proper unique value
  73.     limit: self  0    \ indexed-obj method
  74.     ?DO
  75.         I select: super> obj_array
  76.         self I init: super> radioBut
  77.     LOOP
  78.     ;m
  79.  
  80. :m new:  { wptr -- }
  81.     
  82.     limit: self  0    \ indexed-obj method
  83.     ?DO
  84.         i select: super> obj_array
  85.         
  86.         get: left  ( x)
  87.         get: top
  88.         i get: yspacing * + ( y) MoveTo: super>    radioBut
  89.  
  90.     wptr new: super> radioBut
  91.     LOOP
  92.     
  93.     \ now turn the desired button "on"
  94.     get: nowOn select: super
  95.     1 put: super
  96.     ;m
  97.  
  98. :m draw:
  99.     limit: self  0    \ indexed-obj method
  100.     ?DO
  101.         I select: super> obj_array
  102.         draw: super> radioBut
  103.     LOOP
  104.     ;m
  105.  
  106. :m release:
  107.     limit: self  0    \ indexed-obj method
  108.     ?DO
  109.         I select: super> obj_array
  110.         release: super> radioBut
  111.     LOOP
  112.     ;m
  113.  
  114. :m activate:
  115.     limit: self  0    \ indexed-obj method
  116.     ?DO
  117.         I select: super> obj_array
  118.         activate: super> radioBut
  119.     LOOP
  120.     ;m
  121.  
  122. :m deactivate:
  123.     limit: self  0    \ indexed-obj method
  124.     ?DO
  125.         I select: super> obj_array
  126.         deactivate: super> radioBut
  127.     LOOP
  128.     ;m
  129.  
  130. :m hit?:    { \ flg -- b }
  131.     false -> flg
  132.     limit: self  0    \ indexed-obj method
  133.     ?DO
  134.         I select: super> obj_array
  135.         hit?: super> radioBut
  136.             IF I put: nowOn true -> flg leave THEN    \ we also have f on the stack if true
  137.     LOOP flg ;m
  138.  
  139. :m get:  ( -- idx )    \ returns which button is on
  140.     get: nowOn ;m
  141.  
  142. :m put: { idx -- }    \ manually select a button
  143.     idx othersOff: self
  144.     idx select: super
  145.     idx put: nowOn
  146.     1 put: super ;m
  147.  
  148. :m SetTitle: ( addr len idx -- )
  149.     select: super
  150.     setTitle: super ;m
  151.  
  152. :m action: ( cfa idx -- )
  153.     select: super
  154.     action: super ;m
  155.  
  156. ;class
  157.  
  158. endload
  159.  
  160. *** EXAMPLE USE
  161.  
  162. selwindow w
  163. test: w 
  164.  
  165. 4 radioGroup r
  166. r add: w
  167.  
  168.